PC WORLD Online - Word ▌τin Faydal² Makrolar

Resim Boyutland²rma

Bir Word belgesinin iτinde resim kullan²yorsunuz. Ancak paragraflar² formatlarken resimlerin boyutunu da de≡i■tirmek zorunuza gidiyorsa, bunu bir maro yard²m² ile otomatik olarak yapabilirsiniz. Resim boyutland²rma makromuz seτili olan bir resmi, resmin bulundu≡u paragraf²n geni■li≡ine g÷re bⁿyⁿtⁿyor veya kⁿτⁿltⁿyor. Bu arada perspektifi bozmamak iτin X ve Y eksenlerini e■it ÷lτⁿlerde de≡i■tiriyor. E≡er sayfan²n X veya Y eksenlerinden birinde ta■ma varsa, makro en bⁿyⁿk eksene g÷re resmi otomatik olarak boyutland²r²yor.

makro 3: resimboyut

Sub MAIN
Ret2 = ScaleObjectDefault
Select Case Ret2
	Case - 1
		MsgBox "Lⁿtfen ÷nce boyutlad²r²lacak olan resmi seτin."
	Case - 2
		MsgBox "Resim boyutland²r²lam²yor."
	Case Else
End Select
End Sub

Function ScaleObjectDefault
NL$ = Chr$(13)
Dim dlg As ToolsOptionsGeneral
GetCurValues dlg
CurrentUnits = dlg.Units

ToolsOptionsGeneral .Units = 1
Dim dlg2 As FilePageSetup
GetCurValues dlg2
LeftMargin$ = dlg2.LeftMargin
RightMargin$ = dlg2.RightMargin
PageWidth$ = dlg2.PageWidth
PageHeight$ = dlg2.PageHeight
TopMargin$ = dlg2.TopMargin
BottomMargin$ = dlg2.BottomMargin
LeftMargin = Val(LeftMargin$)
RightMargin = Val(RightMargin$)
PageWidth = Val(PageWidth$)
PageHeight = Val(PageHeight$)
TopMargin = Val(TopMargin$)
BottomMargin = Val(BottomMargin$)

REM Get current indents
Dim Dlg3 As FormatParagraph
GetCurValues Dlg3
XLeft$ = Dlg3.LeftIndent
XRight$ = Dlg3.RightIndent
XLeft = Val(XLeft$)
XRight = Val(XRight$)
XLeft = LeftMargin + XLeft
If XRight > 0 Then
	XRight = PageWidth - RightMargin - XRight
Else
	XRight = PageWidth - RightMargin
EndIf

On Error Goto NotaPicture
Dim Dlg4 As FormatPicture
GetCurValues Dlg4
tSizeX$ = Dlg4.SizeX
tSizeY$ = Dlg4.SizeY
tScaleX$ = Dlg4.ScaleX
tScaleY$ = Dlg4.ScaleY
SizeX = Val(tSizeX$)
SizeY = Val(tSizeY$)
ScaleX = Val(tScaleX$)
ScaleY = Val(tScaleY$)
RealX = SizeX / ScaleX * 100
RealY = SizeY / ScaleY * 100

On Error Goto CantScale
AvailWidth = XRight - XLeft
AvailHeight = PageHeight - TopMargin - BottomMargin
ScaleX = AvailWidth / RealX * 100
ScaleY = AvailHeight / RealY * 100

If ScaleX < ScaleY Then
	ScaleAmount = ScaleX
Else
	ScaleAmount = ScaleY
EndIf

ScaleAmount$ = Str$(ScaleAmount) + "%"
FormatPicture .SetSize = 0, .ScaleX = ScaleAmount$, \
		.ScaleY = ScaleAmount$
ScaleObjectDefault = 0
Goto EndScaleDefault

CantScale:
ScaleObjectDefault = - 2
Goto EndScaleDefault

NotaPicture:
ScaleObjectDefault = - 1

EndScaleDefault:
ToolsOptionsGeneral .Units = CurrentUnits
Err = 0
End Function